home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / Src / Ch12 / ScaleAt.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-06-16  |  4.1 KB  |  142 lines

  1. VERSION 5.00
  2. Begin VB.Form frmScaleAt 
  3.    Caption         =   "ScaleAt"
  4.    ClientHeight    =   4425
  5.    ClientLeft      =   2325
  6.    ClientTop       =   495
  7.    ClientWidth     =   4215
  8.    LinkTopic       =   "Form1"
  9.    PaletteMode     =   1  'UseZOrder
  10.    ScaleHeight     =   4425
  11.    ScaleWidth      =   4215
  12.    Begin VB.OptionButton optSize 
  13.       Caption         =   "Normal"
  14.       Height          =   255
  15.       Index           =   1
  16.       Left            =   1680
  17.       TabIndex        =   3
  18.       Top             =   4080
  19.       Value           =   -1  'True
  20.       Width           =   855
  21.    End
  22.    Begin VB.OptionButton optSize 
  23.       Caption         =   "Little"
  24.       Height          =   255
  25.       Index           =   2
  26.       Left            =   3000
  27.       TabIndex        =   2
  28.       Top             =   4080
  29.       Width           =   855
  30.    End
  31.    Begin VB.OptionButton optSize 
  32.       Caption         =   "Big"
  33.       Height          =   255
  34.       Index           =   0
  35.       Left            =   360
  36.       TabIndex        =   1
  37.       Top             =   4080
  38.       Width           =   855
  39.    End
  40.    Begin VB.PictureBox picCanvas 
  41.       Height          =   3975
  42.       Left            =   0
  43.       ScaleHeight     =   -7
  44.       ScaleLeft       =   -1
  45.       ScaleMode       =   0  'User
  46.       ScaleTop        =   6
  47.       ScaleWidth      =   7
  48.       TabIndex        =   0
  49.       Top             =   0
  50.       Width           =   4215
  51.    End
  52. Attribute VB_Name = "frmScaleAt"
  53. Attribute VB_GlobalNameSpace = False
  54. Attribute VB_Creatable = False
  55. Attribute VB_PredeclaredId = True
  56. Attribute VB_Exposed = False
  57. Option Explicit
  58. Private NumSegments As Integer
  59. Private Segments() As Segment
  60. ' Hold two points for a line segment.
  61. Private Type Segment
  62.     fr_pt(1 To 3) As Single
  63.     to_pt(1 To 3) As Single
  64.     fr_tr(1 To 3) As Single
  65.     to_tr(1 To 3) As Single
  66. End Type
  67. Private CurrentT(1 To 3, 1 To 3) As Single
  68. ' Make the data we will transform and draw.
  69. Private Sub CreateData()
  70.     ' Create the axes.
  71.     MakeSegment 0, 0, 5, 0
  72.     MakeSegment 0, 0, 0, 5
  73.     ' Create an object to manipulate.
  74.     MakeSegment 1, 1, 2, 1
  75.     MakeSegment 2, 1, 2, 2
  76.     MakeSegment 2, 2, 1, 2
  77.     MakeSegment 1, 2, 1, 1
  78.     MakeSegment 1, 1, 2, 2
  79.     MakeSegment 2, 1, 1, 2
  80. End Sub
  81. ' Draw all the transformed segments.
  82. Private Sub DrawSegments(ByVal pic As PictureBox)
  83. Dim i As Integer
  84. Dim x1 As Single
  85. Dim y1 As Single
  86. Dim x2 As Single
  87. Dim y2 As Single
  88.     pic.Cls
  89.     TransformPicture CurrentT
  90.     For i = 1 To NumSegments
  91.         x1 = Segments(i).fr_tr(1)
  92.         y1 = Segments(i).fr_tr(2)
  93.         x2 = Segments(i).to_tr(1)
  94.         y2 = Segments(i).to_tr(2)
  95.         pic.Line (x1, y1)-(x2, y2)
  96.     Next i
  97. End Sub
  98. ' Load the data.
  99. Private Sub Form_Load()
  100.     m2Identity CurrentT
  101.     CreateData
  102. End Sub
  103. ' Make a new segment.
  104. Private Sub MakeSegment(x1 As Single, y1 As Single, x2 As Single, y2 As Single)
  105.     NumSegments = NumSegments + 1
  106.     ReDim Preserve Segments(1 To NumSegments)
  107.     Segments(NumSegments).fr_pt(1) = x1
  108.     Segments(NumSegments).fr_pt(2) = y1
  109.     Segments(NumSegments).fr_pt(3) = 1
  110.     Segments(NumSegments).to_pt(1) = x2
  111.     Segments(NumSegments).to_pt(2) = y2
  112.     Segments(NumSegments).to_pt(3) = 1
  113. End Sub
  114. ' Transform all segments except the axes.
  115. Private Sub TransformPicture(M() As Single)
  116. Dim i As Integer
  117.     For i = 1 To 2
  118.         m2PointCopy Segments(i).fr_tr, Segments(i).fr_pt
  119.         m2PointCopy Segments(i).to_tr, Segments(i).to_pt
  120.     Next i
  121.     For i = 3 To NumSegments
  122.         m2Apply Segments(i).fr_pt, M, Segments(i).fr_tr
  123.         m2Apply Segments(i).to_pt, M, Segments(i).to_tr
  124.     Next i
  125. End Sub
  126. ' Redraw the picture.
  127. Private Sub picCanvas_Paint()
  128.     DrawSegments picCanvas
  129. End Sub
  130. ' Change the scale.
  131. Private Sub optSize_Click(Index As Integer)
  132.     Select Case Index
  133.         Case 0  ' Big.
  134.             m2ScaleAt CurrentT, 2, 2, 1.5, 1.5
  135.         Case 1  ' Normal.
  136.             m2Identity CurrentT
  137.         Case 2  ' Little.
  138.             m2ScaleAt CurrentT, 0.5, 0.5, 1.5, 1.5
  139.     End Select
  140.     picCanvas.Refresh
  141. End Sub
  142.